# Title     : TODO
# Objective : TODO
# Created by: zhw
# Created on: 9/8/21

# 是非变量转换
# 定类变量转换
# 定序变量转换
# 字符串数据转换
# 日期数据转换：年度转换
# 日期数据转换：月度转换
# 日期数据转换：星期转换

# 是非或二值变量到二元变量的转换 ----
transform_binary_variable <- function(x, reference = NULL){
  # 是非变量或二值定性变量的数值转换
  # 对数据集中存在的是非型变量或者二值定性变量进行二元数值转换。例如“是”转化为1，
  # “否”转化为0。
  # 参数：
  #   x 需要转换的变量
  #   reference 变量x中需要与1对应的值
  # 返回值：
  #   将x转化为数值为0或1且等长度的向量。当reference缺失时，默认将x[1]作为1的转换
  #   对象，否则以reference作为1的转换对象。
  x_unique <- unique(x)
  if (is.null(reference)) {
    ref_1 <- x_unique[1]   # x中需要与1对应的值
  }
  else{
    if(reference %in% x_unique){
      ref_1 <- reference
    }
    else{
      e <- paste("reference = ", reference, ", 不在x中.", sep = '')
      stop(e)
    }
  }
  index_true <- x %in% ref_1
  x_binary <- rep(1, length(x))
  x_binary[!index_true] <- 0
  return(x_binary)
}


# 定类变量转换 ----
transform_categorical_variable <- function(x, skip=NULL){
  # 定类变量转换
  # 将包含有m个类别值的定类变量转化为一个等长且列数为m-1的虚拟变量矩阵。如果没有指定
  # 需要省略的类别值，默认省略定类变量中的第一个类别。
  # 参数：
  #   x  一个包含2个以上类别值的向量。
  #   skip  指定虚拟变量矩阵中需要省略的类别。缺省时，默认为x的第一个取值
  # 返回值：
  #   一个仅包含数值0和1的虚拟变量矩阵，长度与x相等，列长为x取值类别数目减1.
  n <- length(x)
  x_unique <- unique(x) # 提取x的取值范围
  if(is.null(skip)){
    x_skip <- x_unique[1] # 设置虚拟变量矩阵中需要省略的类别
  }
  else{
    if(skip %in% x_unique){
    x_skip <- skip
    }
    else{
      e <- paste("skip=", skip, "不属于x的取值范围.", sep = "")
      stop(e)
    }
  }
  # 剔除x_skip
  x_skip_position <- which(x_unique %in% x_skip)
  x_unique_skip <- x_unique[-x_skip_position]
  # 建立虚拟变量矩阵
  m <- sapply(x_unique_skip, function(a, b){
    # 从x_unique_skip中依次提取每个类别，分别建立对应的0和1值向量
    return(as.numeric(b %in% a))
  }, b = x, USE.NAMES = TRUE)
  return(m)
}

# 测试
data <- data.frame(level = sample(c("a","b","c"), size = 10, replace = TRUE))
transform_categorical_variable(x = data$level)
transform_categorical_variable(x = data$level, skip = "a")

# 定序变量转换 ----

# 字符串数据转换 ----
transform_string_numeric <- function(x, symbol = NULL){
  # 字符串类型数据的数值转化
  # 自动处理带有特殊符号的数值数据
  # 参数：
  #   x 一个包含特殊符号的数值字符串向量
  #   symbol 可选参数。用于指定x中需要剔除的特殊符号
  # 返回值：
  #   一个浮点数值型向量
  if(is.null(symbol)){
    expr <- "(-?\\d{1,})(.\\d{1,})?"  # 数值匹配的正则表达式
    expr_match <- regexpr(pattern = expr, text = x) # 匹配数值在x中的位置
    expr_extract <- regmatches(x = x, m = expr_match) # 提取数值
    return(as.numeric(expr_extract))
  }
  else{
    expr <- paste("\\", symbol, sep = "")  # 设置手动指定的特殊字符正则表达式
    # 将字符
    x_replacement <- do.call(gsub, list(x = x, pattern = expr,
                                        replacement = "", perl = TRUE))
    return(as.numeric(x_replacement))
  }
}

# 测试
data <- c("-95%", "45.6%", "9.3%")
transform_string_numeric(x = data, symbol = "%")
data <- c("9.2$", "0.8$", "10.5$")
transform_string_numeric(x = data)
data <- c("增长5%", "降低4.2%","提升9.8%")
transform_string_numeric(x = data)

# 日期数据整形
transform_date <- function(x, x.format = NULL){
  # 日期字符串标准化
  # 通过指定日期字符串的格式，转化为POSIX格式日期YYYY-MM-DD, 定义从格林威治时间
  # 1970年01月01日00时00分00秒起至现在的总秒数.
  # 参数:
  #   x 一个日期类型的向量
  #   x.format 指定x的格式. 例如"2021年01月23日", 格式为"%Y年%m月%d日"。可选参数
  #          如下：
  #             %y 两位数字表示的年份（00-99)。例如，数值是18，格式%y，表示2018年
  #             %Y：四位数字表示的年份（0000-9999）
  #             %m：两位数字的月份，取值范围是01-12，或1-12
  #             %d：月份中的天，取值范围是01-31
  #             %e：月份中的天，取值范围是1-31
  #         设置默认NULL时，采用lubridate包中ymd函数猜测x的格式。
  # 返回
  #   一个采用POSIX标准化的日期数据向量.
  if(is.null(x.format)){
    if(!require(lubridate)){  # 使用lubridate包中ymd函数猜测日期格式
      stop("lubridate包未安装.")
    }
    else{
      x_transform <- lubridate::ymd(x)
    }
  }
  else{  # 使用指定格式转化日期
    x_transform <- as.Date(x, format = x.format,
                           tryFormats = c("%Y-%m-%d", "%Y/%m/%d",
                                          "%Y年%m月%d日"))
  }
  return(x_transform)
}

# 测试
data <- c("2021年1月1日","2021年1月2日","2021年5月23日")
transform_date(x = data) # 不设定传入数据的日期格式，猜测格式
transform_date(x = data, x.format = "%Y年%m月%e日") # 指定传入数据的日期格式

# 日期数据转换：年度转换 ----
get_date_year <- function(x, format=NULL){
  # 从传入数据中提取年度信息
  # 参数：
  #   x 一个日期向量，或者符合POXIT标准的日期向量
  #   format 当x不符合POXIT标准时，通过指定x的格式进行POXIT格式转化.
  #            例如"2021年01月23日", 格式为"%Y年%m月%d日"。可选参数
  #            如下：
  #              %y 两位数字表示的年份（00-99)。例如，数值是18，格式%y，表示2018年
  #              %Y：四位数字表示的年份（0000-9999）
  #              %m：两位数字的月份，取值范围是01-12，或1-12
  #              %d：月份中的天，取值范围是01-31
  #              %e：月份中的天，取值范围是1-31
  #            设置默认NULL时，采用lubridate包中ymd函数猜测x的格式。
  # 返回值：
  #   一个仅含有年份信息的字符串向量

  # 利用transform_date处理传入的日期数据格式
  x_transform <- transform_date(x = x, x.format = format)
  x_year <- lubridate::year(x_transform)
  return(x_year)
}

# 测试
data <- c("2021年1月1日","2021年1月2日","2021年5月23日")
get_date_year(x = data_poxis)

# 日期数据转换：月度转换 ----
get_date_month <- function(x, format=NULL){
  # 从传入数据中提取月度信息
  # 参数：
  #   x 一个日期向量，或者符合POXIT标准的日期向量
  #   format 当x不符合POXIT标准时，通过指定x的格式进行POXIT格式转化.
  #            例如"2021年01月23日", 格式为"%Y年%m月%d日"。可选参数
  #            如下：
  #              %y 两位数字表示的年份（00-99)。例如，数值是18，格式%y，表示2018年
  #              %Y：四位数字表示的年份（0000-9999）
  #              %m：两位数字的月份，取值范围是01-12，或1-12
  #              %d：月份中的天，取值范围是01-31
  #              %e：月份中的天，取值范围是1-31
  #            设置默认NULL时，采用lubridate包中ymd函数猜测x的格式。
  # 返回值：
  #   一个仅含有1-12月份信息的向量

  # 利用transform_date处理传入的日期数据格式
  x_transform <- transform_date(x = x, x.format = format)
  x_month <- lubridate::month(x_transform, label = FALSE)
  return(x_month)
}

# 测试
data <- c("2021年1月1日","2021年1月2日","2021年5月23日")
get_date_month(x = data_poxis)


# 日期数据转换：星期转换 ----
get_date_week <- function(x, format=NULL){
  # 从传入数据中提取星期信息
  # 参数：
  #   x 一个日期向量，或者符合POXIT标准的日期向量
  #   format 当x不符合POXIT标准时，通过指定x的格式进行POXIT格式转化.
  #            例如"2021年01月23日", 格式为"%Y年%m月%d日"。可选参数
  #            如下：
  #              %y 两位数字表示的年份（00-99)。例如，数值是18，格式%y，表示2018年
  #              %Y：四位数字表示的年份（0000-9999）
  #              %m：两位数字的月份，取值范围是01-12，或1-12
  #              %d：月份中的天，取值范围是01-31
  #              %e：月份中的天，取值范围是1-31
  #            设置默认NULL时，采用lubridate包中ymd函数猜测x的格式。
  # 返回值：
  #   一个仅含有星期信息的字符串向量

  # 利用transform_date处理传入的日期数据格式
  x_transform <- transform_date(x = x, x.format = format)
  x_week <- weekdays(x_transform)
  return(x_week)
}

# 测试
data <- c("2021年1月1日","2021年1月2日","2021年5月23日")
get_date_week(x = data_poxis)